(module level1 mzscheme
  (require "../core.scm")
  (require "level0.scm")

  ;; Basic Combinators
  (define-cat apply true swap () if)
  (define-cat apply2 under apply (apply) dip)
  (define-cat dip swap quote compose apply) 
  (define-cat dip2 swap (dip) dip) 
  
  ;; Classical Combinators
  (define-cat b  [k] [[s] k] s)
  (define-cat c  [[k] k] [[s] [b] b] s)
  (define-cat d  [b] b)
  (define-cat i  [k] [k] s)
  (define-cat k  [pop] dip)
  (define-cat ki [i] k)
  (define-cat l  [m] [b] c)
  (define-cat m  dup apply)
  (define-cat o  [i] s)
  (define-cat r  [t] [b] b)
  (define-cat s  peek swap [curry] dip2 apply)
  (define-cat t  [i] c)
  (define-cat u  [o] l)
  (define-cat v  [t] [c] b)
  (define-cat w  [[r] [m] b] c)
  (define-cat y  dup quote [y] compose swap apply)
  
  ;; Boolean Operations
  (define-cat      and     quote (false) if)
  (define-cat      nand    and not)
  (define-cat      nor     or not)
  (define-cat      not     (false) (true) if)
  (define-cat      or      (true) swap quote if)

  ;; Comparison Functions
  (define-cat      eqz     dup 0 eq)
  (define-cat      eqf     (dupd eq) curry)
  (define-cat      neq     eq not)
  (define-cat      neqf    (dupd neq) curry)
  (define-cat      neqz    dup 0 neq)
  
  ;; Function Construction
  (define-cat      curry    (quote) dip compose)
  (define-cat      curry2   curry curry)
  (define-cat      rcompose swap compose)
  (define-cat      rcurry   swap curry)
  
  ;; Looping Functions
  (define-cat      for      swap (dip inc) curry (dup) rcompose swap neqf 0 bury while pop)
  (define-cat      for_each [dip] curry [uncons swap] rcompose whilene)
  (define-cat      repeat   swap [dip dec] curry [neqz] while pop)
  (define-cat      rfor     swap [dip dec] curry [dup] rcompose whilenz)
  (define-cat      whilen   [not] compose while)
  (define-cat      whilene  [empty not] while pop)
  (define-cat      whilenz  (neqz) while pop)
  
  ;; List Functions
  (define-cat      cat        rev swap (cons) fold)
  (define-cat      consd      (cons) dip)
  (define-cat      count      dup 0 (pop inc) fold)
  (define-cat      count_while[dup 0 swap] dip [[inc] dip] swap [uncons] rcompose while pop)
  (define-cat      drop       [[tail] dip dec] whilenz)
  (define-cat      drop_while count_while drop)
  (define-cat      filter     [rev] dip [[cons] [pop] if] compose [dup] rcompose nil swap fold)
  (define-cat      first      dup uncons popd)
  (define-cat      flatten    rev nil (cat) fold)
  (define-cat      fold       swapd [dip] curry [uncons swap] rcompose whilene)
  (define-cat      gen        nil swap [bury] dip [[dup consd] rcompose] dip [dup] rcompose while pop)
  (define-cat      head       uncons popd)
  (define-cat      last       count dec nth)
  (define-cat      map        rmap rev)
  (define-cat      mid        count 2 div_int nth)
  (define-cat      move_head  uncons swap consd)
  (define-cat      n          nil swap (cons) swap for)
  (define-cat      nth        dupd drop head)
  (define-cat      pair       (unit) dip cons)
  (define-cat      rev        nil (cons) fold)
  (define-cat      rmap       nil swap (cons) compose fold)
  (define-cat      set_at     swapd split_at (tail swons) dip cat)
  (define-cat      small      count 1 lteq_int)
  (define-cat      split      dup2 (filter) dip2 (not) compose filter)
  (define-cat      split_at   nil bury (move_head) swap repeat swap)
  (define-cat      swons      swap cons)
  (define-cat      tail       uncons pop)
  (define-cat      take       nil bury [[move_head] dip dec] whilenz pop rev)
  (define-cat      take_while count_while take)
  (define-cat      triple     (pair) dip cons)
  (define-cat      unpair     uncons (head) dip)
  (define-cat      unit       nil swap cons)
  
  ;; Stack Manipulation
  (define-cat      bury       swap swapd)
  (define-cat      dig        swapd swap)
  (define-cat      dup2       over over)
  (define-cat      dupd       (dup) dip)
  (define-cat      over       dupd swap)
  (define-cat      peek       (dupd) dip dig)
  (define-cat      poke       (popd) dip swap)
  (define-cat      pop2       pop pop)
  (define-cat      pop3       pop pop pop)
  (define-cat      popd       (pop) dip)
  (define-cat      swap2      (bury) dip bury)
  (define-cat      swapd      (swap) dip)
  (define-cat      under      dup swapd)
  
  ;; Integer Operations
  (define-cat      dec        1 sub_int)
  (define-cat      even       dup 2 mod_int 0 eq)
  (define-cat      inc        1 add_int)
  (define-cat      sub_int    neg_int add_int)
  (define-cat      min_int    dup2 gt_int (popd) (pop) if)
  (define-cat      max_int    dup2 gt_int (pop) (popd) if)
  (define-cat      odd        dup 2 mod_int 1 eq)
  (define-cat      gt_int     lteq_int not)
  (define-cat      gteq_int   lt_int not)
  (define-cat      lteq_int   dup2 eq (lt_int) dip or))
